[Previous] [Next]

Polymorphism

The term polymorphism describes the capability of different objects to expose a similar set of properties and methods. The most obvious and familiar examples of polymorphic objects are Visual Basic's own controls, most of which share property and method names. The advantage of polymorphism is evident when you think of the sort of generic routines that work on multiple objects and controls:

' Change the BackColor property for all the controls on the form.
Sub SetBackColor(frm As Form, NewColor As Long)
    Dim ctrl As Control
    On Error Resume Next            ' Account for invisible controls.
    For Each ctrl In frm.Controls
        ctrl.BackColor = NewColor
    Next
End Sub

Leveraging Polymorphism

You can exploit the benefits of polymorphism to write better code in many ways. In this section, I examine the two that are most obvious: procedures with polymorphic arguments and classes with polymorphic methods.

Polymorphic procedures

A polymorphic procedure can do different things depending on which arguments you pass it. In previous chapters, I have often implicitly used this idea, for example, when writing routines that use a Variant argument to process arrays of different types. Let's see now how you can expand on this concept for writing more flexible classes. I'll illustrate a simple CRectangle class, which exposes a number of simple properties (Left, Top, Width, Height, Color, and FillColor) and a Draw method that displays it on a surface. Here's the source code of the class module:

' In a complete implementation, we would use property procedures.
Public Left As Single, Top As Single
Public Width As Single, Height As Single
Public Color As Long, FillColor As Long    

Private Sub Class_Initialize()
    Color = vbBlack
    FillColor = -1              ' -1 means "not filled"
End Sub

' A pseudoconstructor method
Friend Sub Init(Left As Single, Top As Single, Width As Single, Height As _
    Single, Optional Color As Variant, Optional FillColor As Variant)
    ' .... code omitted for brevity
End Sub

' Draw this shape on a form, a picture box, or the Printer object.
Sub Draw(pic As Object)
    If FillColor <> -1 Then
        pic.Line (Left, Top)-Step(Width, Height), FillColor, BF
    End If
    pic.Line (Left, Top)-Step(Width, Height), Color, B
End Sub

For the sake of brevity, all the properties are implemented as Public variables, but in a real implementation you would surely use Property procedures to enforce validation rules. The real focal point of this class, however, is the Draw method, which expects an Object argument. This means that we can display the rectangle on any object that supports the Line method:

Dim rect As New CRect
' Create a white rectangle with a red border.
rect.Init 1000, 500, 2000, 1500, vbRed, vbWhite
' Display it wherever you want.
If PreviewMode Then
    rect.Draw Picture1          ' A picture box
Else
    rect.Draw Printer           ' A printer
End If

This first form of polymorphism is interesting, though limited. In this particular case, in fact, we can't do much more than what we've done because forms, PictureBox controls, and the Printer are the only objects that support the Line method with its exotic syntax. The really important point is that the client application benefits from this capability to simplify its code.

Polymorphic classes

The real power of polymorphism becomes apparent when you create multiple class modules and select the names of their properties and methods in a way that ensures a complete or partial polymorphism among them. For example, you can create a CEllipse class that's completely polymorphic with the CRectangle class, even if the two classes are implemented differently:

' The CEllipse class
Public Left As Single, Top As Single
Public Width As Single, Height As Single
Public Color As Long, FillColor As Long    

Private Sub Class_Initialize()
    Color = vbBlack
    FillColor = -1             ' -1 means "not filled"
End Sub

' Draw this shape on a form, a picture box, or the Printer object.
Sub Draw(pic As Object)
    Dim aspect As Single, radius As Single
    Dim saveFillColor As Long, saveFillStyle As Long
    aspect = Height / Width
    radius = IIf(Width > Height, Width / 2, Height / 2)
    If FillColor <> -1 Then
        saveFillColor = pic.FillColor
        saveFillStyle = pic.FillStyle
        pic.FillColor = FillColor
        pic.FillStyle = vbSolid
        pic.Circle (Left + Width / 2, Top + Height / 2), radius, Color, _
            , , aspect
        pic.FillColor = saveFillColor
        pic.FillStyle = saveFillStyle
    Else
        pic.Circle (Left + Width / 2, Top + Height / 2), radius, Color, _
            , , aspect
    End If
End Sub

You can also create classes that are only partially polymorphic with respect to CRectangle. For example, a CLine class might support the Draw method and the Color property but use different names for its other members:

' The CLine class
Public X As Single, Y As Single
Public X2 As Single, Y2 As Single
Public Color As Long

Private Sub Class_Initialize()
    Color = vbBlack
End Sub

' Draw this shape on a form, a picture box, or the Printer object.
Sub Draw(pic As Object)
    pic.Line (X, Y)-(X2, Y2), Color
End Sub

Now you have three classes that are polymorphic with one another with respect to their Draw methods and their Color properties. This permits you to create a first version of a very primitive CAD-like application, named Shapes, shown in Figure 7-5. You can do this by using an array or a collection that holds all your shapes so that you can redraw all of them quite easily. To keep the client code as concise and descriptive as possible, you can also define a number of factory methods in a separate BAS module (not shown here because it's not terribly interesting for our purposes):

Click to view at full size.

Figure 7-5. Playing with polymorphic shapes.

' This is a module-level variable.
Dim Figures As Collection

Private Sub Form_Load()
    CreateFigures
End Sub
Private Sub cmdRedraw_Click()
    RedrawFigures
End Sub

' Create a set of figures.
Private Sub CreateFigures()
    Set Figures = New Collection
    Figures.Add New_CRectangle(1000, 500, 1400, 1200, , vbRed)
    Figures.Add New_CRectangle(4000, 500, 1400, 1200, , vbCyan)
    Figures.Add New_CEllipse(2500, 2000, 1400, 1200, , vbGreen)
    Figures.Add New_CEllipse(3500, 3000, 2500, 2000, , vbYellow)
    Figures.Add New_CRectangle(4300, 4000, 1400, 1200, , vbBlue)
    Figures.Add New_CLine(2400, 1100, 4000, 1100, vbBlue)
    Figures.Add New_CLine(1700, 1700, 1700, 4000, vbBlue)
    Figures.Add New_CLine(1700, 4000, 3500, 4000, vbBlue)
End Sub

' Redraw figures.
Sub RedrawFigures()
    Dim Shape As Object
    picView.Cls
    For Each Shape In Figures
        Shape.Draw picView
    Next
End Sub

While complete polymorphism is always preferable, you can still use a lot of interesting techniques when objects have just a few properties in common. For example, you can quickly turn the contents of the Figures collection into a series of wire-framed objects:

On Error Resume Next     ' CLine doesn't support the FillColor property.
For Each Shape In Figures
    Shape.FillColor = -1
Next

It's easy to add sophistication to this initial example. For example, you might add support for moving and zooming objects, using the Move and Zoom methods. Here's a possible implementation of these methods for the CRectangle class:

' In CRectangle class module...
' Move this object.
Sub Move(stepX As Single, stepY As Single)
    Left = Left + stepX
    Top = Top + stepY
End Sub

' Enlarge or shrink this object on its center.
Sub Zoom(ZoomFactor As Single)
    Left = Left + Width * (1 - ZoomFactor) / 2
    Top = Top + Height * (1 - ZoomFactor) / 2
    Width = Width * ZoomFactor
    Height = Height * ZoomFactor
End Sub

The implementation for the CEllipse class is identical to this code because it's perfectly polymorphic with CRectangle and therefore exposes Left, Top, Width, and Height properties. The CLine class supports both the Move and the Zoom method as well, even if their implementation is different. (See the code on the companion CD for more details.)

Figure 7-6 shows an improved Shapes sample program, which also permits you to move and zoom the objects on the playground. This is the code behind the buttons on the form:

Private Sub cmdMove_Click(Index As Integer)
    Dim shape As Object
    For Each shape In Figures
        Select Case Index
            Case 0: shape.Move 0, -100    ' Up
            Case 1: shape.Move 0, 100     ' Down
            Case 2: shape.Move -100, 0    ' Left
            Case 3: shape.Move 100, 0     ' Right
        End Select
    Next
    RedrawFigures
End Sub

Private Sub cmdZoom_Click(Index As Integer)
    Dim shape As Object
    For Each shape In Figures
        If Index = 0 Then
            shape.Zoom 1.1                ' Enlarge
        Else
            shape.Zoom 0.9                ' Reduce
        End If
    Next
    RedrawFigures
End Sub

If you want to appreciate what polymorphism can do for your programming habits, just think of the many lines of code you would have written to solve this simple programming task using any other means. And of course consider that you can apply these techniques to more complex business objects, including Documents, Invoices, Orders, Customers, Employees, Products, and so on.

Click to view at full size.

Figure 7-6. More fun with polymorphic shapes.

Polymorphism and late binding

I haven't yet talked about one aspect of polymorphism in the depth it deserves. The most important trait in common among all the polymorphic examples seen so far is that you have been able to write polymorphic code only because you use generic object variables. For example, the pic argument in the Draw method is declared with As Object, as is the Shape variable in all Click procedures in the preceding code. You might use Variant variables that hold an object reference, but the concept is the same: you are doing polymorphism through late binding.

As you'll recall from Chapter 6, late binding is a technique that has several defects, the most serious being a sloppy performance—it's even hundreds of times slower than early binding—and less robust code. Depending on the particular piece of code you're working on, these defects can easily nullify all the benefits you get from polymorphism. Fortunately, Visual Basic offers a solution to this problem—a great solution, I daresay. To understand how it works, you must be familiar with the concept of interfaces.

Working with Interfaces

When you start using polymorphism in your code, you realize that you're logically subdividing all the properties and methods exposed by your objects into distinct groups. For example, the CRectangle, CEllipse, and CLine classes expose a few members in common (Draw, Move, and Zoom). With real-world objects, which include dozens or even hundreds of properties and methods, creating groups of them isn't just a luxury, it's necessary. A group of related properties and methods is called an interface.

Under Visual Basic 4, any object could have only one interface, the main interface. Starting with version 5, Visual Basic's class modules can include one or more secondary interfaces. This is exactly what you need to better organize your object-oriented code. And you'll see that this innovation has many other beneficial implications.

Creating a secondary interface

In Visual Basic 5 and 6, the definition of a secondary interface requires that you create a separate class module. This module doesn't contain any executable code, just the definition of properties and methods. For this reason, it's often called an abstract class. As with any Visual Basic module, you need to give it a name. It's customary to distinguish interface names from class names by using a leading letter I.

Back to our mini-CAD example: Let's create an interface that gathers the Draw, Move, and Zoom methods—that is, the members in common to all the shapes we're dealing with. This will be the IShape interface. To add some spice, I am also adding the Hidden property:

' The IShape class module
Public Hidden As Boolean

Sub Draw(pic As Object)
    ' (Empty comment to prevent automatic deletion of this routine)
End Sub
Sub Move(stepX As Single, stepY As Single)
    '
End Sub
Sub Zoom(ZoomFactor As Single)
    '
End Sub

NOTE
You might need to add a comment inside all methods to prevent the editor from automatically deleting empty routines when the program is executed.

This class doesn't include any executable statements and only serves as a model for the IShape interface. What really matters are the names of properties and methods, their arguments, and the type of each one of them. For the same reason, you don't need to create pairs of Property procedures because a simple Public variable is usually enough. For only two cases do you need explicit Property procedures:

Interfaces never include Event declarations. Visual Basic takes only Public properties and methods into account when you're using a CLS module as an abstract class that defines a secondary interface.

Implementing the interface

The next step is letting Visual Basic know that the CRectangle, CEllipse, and CLine classes expose the IShape interface. You do this by adding an Implements keyword in the declaration section of each class module:

' In the CRectangle class module
Implements IShape

Declaring that a class exposes an interface is only half of the job because you now have to actually implement the interface. In other words, you must write the code that Visual Basic will execute when any member of the interface is invoked. The code editor does part of the job on your behalf by creating the code template for each individual routine. The mechanism is similar to the one available for events: In the leftmost combo box, you select the name of the interface (it appeared in the box as soon as you moved the caret away from the Implements statement) and select the name of a method or a property in the rightmost combo box, which you can see in Figure 7-7. Notice this important difference from events, though: When you implement an interface, you must create all the procedures listed in this combo box. If you don't do this, Visual Basic won't even run your application. For this reason, the fastest way to proceed is to select all the items in the rightmost combo box to create all the procedure templates, and then add code to them. Note that all names have been prefixed with IShape_, which solves any name conflict with the methods already in the module, and that all routines have been declared to be Private. This is what you want because if they were Public, they would appear in the main interface. Also note that the Hidden property has generated a pair of Property procedures.

Writing the actual code

To complete the implementation of the interface, you must write code inside the procedure templates. If you don't, the program will run but the object will never respond to the IShape interface.

Interfaces are said to be contracts: If you implement an interface, you implicitly agree to respond to all the properties and methods of that interface in a way that complies with the interface specifications. In this case, you're expected to react to the Draw method with code that displays the object, to the Move method with code that moves the object, and so on. If you fail to do so, you're breaking the interface contract and you're the only one to blame for this.

Click to view at full size.

Figure 7-7. Let the code editor create the procedure templates for you.

Let's see how you can implement the IShape interface in your CRectangle class. In this case, you already have the code that displays, moves, and scales the object—namely, the Draw, Move, and Zoom methods in the main interface. One of the goals of secondary interfaces, however, is to get rid of redundant members in the main interface. In line with this, you should delete the Draw, Move, and Zoom methods from CRectangle's primary interface and move their code inside the IShape interface:

' A (private) variable to store the IShape_Hidden property
Private Hidden As Boolean

Private Sub IShape_Draw(pic As Object)
    If Hidden Then Exit Sub
    If FillColor >= 0 Then
        pic.Line (Left, Top)-Step(Width, Height), FillColor, BF
    End If
    pic.Line (Left, Top)-Step(Width, Height), Color, B
End Sub

Private Sub IShape_Move(stepX As Single, stepY As Single)
    Left = Left + stepX
    Top = Top + stepY
End Sub

Private Sub IShape_Zoom(ZoomFactor As Single)
    Left = Left + Width * (1 - ZoomFactor) / 2
    Top = Top + Height * (1 - ZoomFactor) / 2
    Width = Width * ZoomFactor
    Height = Height * ZoomFactor
End Sub

Private Property Let IShape_Hidden(ByVal RHS As Boolean)
    Hidden = RHS
End Property
Private Property Get IShape_Hidden() As Boolean
    IShape_Hidden = Hidden
End Property

This completes the implementation of the IShape interface for the CRectangle class. I won't show here the code for CEllipse and CLine because it's substantially the same, and you'll probably prefer to browse it on the companion CD.

Accessing the secondary interface

Accessing the new interface is simple. All you have to do is declare a variable of the IShape class and assign the object to it:

' In the client code ...
Dim Shape As IShape    ' A variable that points to an interface
Set Shape = Figures(1) ' Get the first figure in the list.
Shape.Draw picView     ' Call the Draw method in the IShape interface.

The Set command in the previous code is somewhat surprising because you would expect that the assignment would fail with a Type Mismatch error. Instead, the code works because the compiler can ascertain that the Figures(1) object (a CRectangle object in this particular sample program) supports the IShape interface and that a valid pointer can be returned and safely stored in the Shape variable. It's as if Visual Basic queried the source CRectangle object, "Do you support the IShape interface?" If it does, the assignment can be completed, otherwise an error is raised. This operation is referred to as QueryInterface, or QI for short.

NOTE
In Chapter 6, you learned that a class is always paired with a VTable structure, which holds the addresses of all its procedures. A class that implements a secondary interface comes with a secondary VTable structure, which of course points to the procedures of that secondary interface. When a QI command is attempted for a secondary interface, the value returned in the target variable is the address of a memory location inside the instance data area, which in turn holds the address of this secondary VTable structure. (See Figure 7-8.) This mechanism enables Visual Basic to deal with primary and secondary interfaces using the same low-level core routines.

Click to view at full size.

Figure 7-8. Secondary interfaces and VTable structures. (Compare this with Figure 6-8.)

QueryInterface is a symmetrical operation, and Visual Basic lets you do assignments in both directions:

Dim Shape As IShape, Rect As CRectangle
' You can create a CRectangle object on the fly.
Set Shape = New CRectangle
Set Rect = Shape                 ' This works.
Rect.Init 100, 200, 400, 800     ' Rect points to primary interface.
Shape.Move 30, 60                ' Shape points to its IShape interface.
' Next statement proves that both variables point to the same instance.
Print Rect.Left, Rect.Top        ' Displays "130" and "260"

Refining the client code

If you implement the IShape interface in the CEllipse and CLine classes as well, you'll see that you can call code inside any of these three classes using the Shape variable. In other words, you're doing polymorphism using a variable of a specific type, hence, you can now use early binding.

When two or more classes share an interface, they're said to be polymorphic with each other with respect to that particular interface. This technique lets you speed up the Shapes program and make it more robust at the same time. What's really astonishing is that you can accomplish all this by replacing one single line in the original client code:

Sub RedrawFigures()
    Dim shape As IShape         ' Instead of "As Object"
    picView.Cls
    For Each shape In Figures
        shape.Draw picView
    Next
End Sub

The performance benefit you can get using this approach can vary greatly. This particular routine spends most of its time doing graphics, so the speed improvement might go unnoticed. Most of the time, however, you'll literally see the difference before your eyes.

Playing with VBA keywords

Before diving into another (I hope) fascinating OOP topic, let's see how a few VBA keywords behave when applied to object variables that point to a secondary interface.

The Set keyword As you just saw, you can freely assign object variables to each other, even if they're of different types. The only condition is that the source object (the right side of the assignment) must implement the target class (the left side of the assignment) as a secondary interface. The opposite is also possible—that is, when the source class is an interface implemented by the target class. In both cases, remember that you're assigning a reference to the same object.

The TypeName function This function returns the name of the original class of the object pointed to by the object variable, regardless of the type of argument. For example, consider this code:

Dim rect As New CRectangle, shape As IShape
Set shape = rect
Print TypeName(shape)     ' Displays "CRectangle", not "IShape"!

The TypeOf...Is statement The TypeOf…Is statement tests whether an object supports a given interface. You can test for primary and secondary interfaces, as in this example:

Dim rect As New CRectangle, shape As IShape
Set shape = rect
' You can pass a variable and test a secondary interface.
If TypeOf rect Is IShape Then Print "OK"          ' Displays "OK"
' You can also pass a variable pointing to a secondary interface
' and test the primary interface (or a different secondary interface).
If TypeOf shape Is CRectangle Then Print "OK"     ' Displays "OK"

In Chapter 6, I suggested that you use TypeName instead of a TypeOf…Is statement. This is correct when you're dealing with primary interfaces exclusively, but when you're testing for a secondary interface you really need TypeOf…Is.

The Is keyword In Chapter 6, I explained that the Is operator simply compares the contents of the involved object variables. This is true only when you're comparing variables that hold pointers to the primary interface: when you compare object variables of different types, Visual Basic is smart enough to understand whether they're pointing to the same instance data area, even if the values stored in the variables are different:

Set shape = rect
Print (rect Is shape)               ' Displays "True".

Support functions to retrieve secondary interfaces

When you get more involved with secondary interfaces, you'll soon find yourself writing a lot of code just to retrieve the secondary interface of an object. This effort usually requires declaring a variable of the given type and executing a Set command. You might instead find it convenient to write a simple function in a BAS module that does it for you:

Function QI_IShape(shape As IShape) As IShape
    Set QI_IShape = shape
End Function

For example, see how you can invoke the Move method in the IShape interface of a CRectangle object:

QI_IShape(rect).Move 10, 20

In most cases, you don't need a temporary variable even when assigning multiple properties or multiple methods:

With QI_IShape(rect)
    .Move 10, 20
    .Zoom 1.2
End With